home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form MailForm Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Mabry Mail" ClientHeight = 6945 ClientLeft = 1290 ClientTop = 3075 ClientWidth = 9705 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 7635 Left = 1230 LinkTopic = "Form1" ScaleHeight = 6945 ScaleWidth = 9705 Top = 2445 Width = 9825 Begin VB.Timer Timer1 Enabled = 0 'False Interval = 1 Left = 5160 Top = 1200 End Begin VB.CheckBox chkHostDelete Caption = "Host &Delete" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 6840 TabIndex = 5 Top = 120 Width = 1215 End Begin VB.TextBox textBody Appearance = 0 'Flat BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Courier New" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2175 Left = 240 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 8 Top = 3720 Width = 8895 End Begin VB.CommandButton cmdHSplit Appearance = 0 'Flat BackColor = &H80000005& BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Courier New" Size = 1.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 90 Left = 120 TabIndex = 11 Top = 2880 Width = 9750 End Begin VB.CommandButton cmdVSplit Appearance = 0 'Flat BackColor = &H80000005& BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2415 Left = 2040 TabIndex = 10 Top = 720 Width = 90 End Begin VB.ListBox listMessages Appearance = 0 'Flat Height = 1230 Left = 5640 TabIndex = 7 Top = 885 Width = 3615 End Begin VB.ListBox listFolders Appearance = 0 'Flat Height = 1470 Left = 0 TabIndex = 6 Top = 1080 Width = 4155 End Begin VB.CheckBox Flag Appearance = 0 'Flat BackColor = &H80000005& Caption = "Flag" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 9720 TabIndex = 9 Top = 360 Visible = 0 'False Width = 690 End Begin VB.CheckBox chkTrace Caption = "T&race" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 5730 TabIndex = 4 Top = 345 Value = 1 'Checked Width = 1110 End Begin VB.CheckBox chkBlocking Caption = "&Blocking" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 5730 TabIndex = 3 Top = 120 Value = 1 'Checked Width = 1065 End Begin VB.CommandButton cmdReply Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Reply" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 2280 TabIndex = 2 Top = 120 Width = 1020 End Begin VB.CommandButton cmdSendMessage Appearance = 0 'Flat BackColor = &H80000005& Caption = "&Send" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1200 TabIndex = 1 Top = 120 Width = 1020 End Begin VB.CommandButton cmdGetMail Appearance = 0 'Flat BackColor = &H80000005& Caption = "&GetMail" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 120 TabIndex = 0 Top = 120 Width = 1020 End Begin MailLib.mMail Mail1 Left = 4560 Top = 1200 _Version = 327680 _ExtentX = 847 _ExtentY = 847 _StockProps = 0 Blocking = 0 'False Debug = 1 Host = "" Timeout = 0 ConnectType = 1 PopPort = 110 SmtpPort = 25 End Begin VB.Label lblPercentage Height = 375 Left = 3600 TabIndex = 12 Top = 120 Width = 735 End Begin VB.Line Line2 BorderColor = &H00808080& X1 = -75 X2 = 7245 Y1 = 690 Y2 = 690 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& X1 = 60 X2 = 7275 Y1 = 15 Y2 = 15 End Begin VB.Menu FileMenu Caption = "&File" Begin VB.Menu FileExit Caption = "E&xit" End End Begin VB.Menu SettingsMenu Caption = "Se&ttings" Begin VB.Menu SettingsUser Caption = "&User..." End Begin VB.Menu SettingsConnection Caption = "&Connection..." End End Begin VB.Menu ShowMenu Caption = "Sh&ow" Begin VB.Menu ShowHeaders Caption = "&Headers" End Begin VB.Menu ShowSourceMenu Caption = "&Source" End End Attribute VB_Name = "MailForm" Attribute VB_Creatable = False Attribute VB_Exposed = False ' Sample program for Mabry Mail Control ' This sample shows both blocking and non-blocking use of ' the Mabry Mail control. Please note that this sample does ' not trap errors returned by the control (connection failure, ' for instance). If an error is returned you'll see the usual VB ' error message box. ' Zane Thomas/Sept 96 Option Explicit ' state is used to determine what to do ' when the Done and DataReady events are fired Dim State As Integer Const StateDisconnected = 0 Const StateGettingEMail = 1 Const StateSelectGroup = 2 Const StateGetArticleIDs = 3 Const StateGetArticle = 4 Const StateGetHeader = 5 Const StateXOver = 6 Const StateConnecting = 7 Const StateConnected = 8 Const StateDisconnecting = 9 Const StateDeleting = 10 Const StateAborting = 11 Dim NextCommand As Integer ' For spacing during Form_Resize Const Margin = 2 Dim vbCrLf As String Dim MailDir As String Dim InboxDir As String Dim CurrentFolder As String Dim GettingMessage As Integer ' enough room for 20 folders Dim DirInfo(20) As DirCounters Private Sub Addline(S As String) textBody.Text = textBody.Text & S & vbCrLf End Sub Private Sub chkBlocking_Click() If (chkBlocking.Value) Then Mail1.Blocking = True Else Mail1.Blocking = False End If End Sub Private Sub chkHostDelete_Click() If (chkHostDelete.Value = 1) Then MsgBox "Messages will be deleted after they are read from the host.", 48 End If End Sub Private Sub cmdConnect_Click() End Sub Private Sub chkTrace_Click() If (chkTrace.Value = 1) Then Mail1.Debug = 1 Else Mail1.Debug = 0 End If End Sub Private Sub cmdGetMail_Click() State = StateConnecting Mail1.Host = g_PopHost Mail1.LogonName = g_PopUserName Mail1.LogonPassword = g_PopPassword Mail1.Action = MailActionConnect If (Mail1.Blocking = True) Then Mail1_Done End If End Sub Private Sub cmdReply_Click() NewMessage.txtTo = Mail1.From NewMessage.Show End Sub Private Sub cmdSendMessage_Click() NewMessage.Show End Sub Private Sub DisplayAttachmentMarker(Part As Integer) Dim pos As Integer Dim S As String Addline "----- Attachment " & Format(Part) & " -----" Addline "Content: " & Mail1.ContentType & "\" & Mail1.ContentSubtype & " Double-click this line to display" pos = 0 If (Len(Mail1.ContentDisposition) > 0) Then pos = InStr(Mail1.ContentDisposition, "name=") If (pos <> 0) Then S = Mid(Mail1.ContentDisposition, pos + 5) End If End If If (pos = 0) Then If (Len(Mail1.ContentSubtypeParameters) > 0) Then pos = InStr(Mail1.ContentSubtypeParameters, "name=") If (pos <> 0) Then S = Mid(Mail1.ContentSubtypeParameters, pos + 5) End If End If End If If (S <> "") Then Addline "filename: " & S End If Addline "------------------------" End Sub Private Sub DisplayBody() Dim I As Integer Dim enc As String enc = Mail1.ContentTransferEncoding If (enc = "base64" Or enc = "quoted-printable" Or enc = "mac-binhex40" Or enc = "x-uuencode") Then ' ' Decode body and put it back in body. ' ' NOTE: Once the body is changed you'd best not try ' to decode it again. Here the Buffer is used as the ' destination for the decoded data. ' Mail1.Flags = MailSrcIsBody Or MailDstIsBuffer Mail1.Action = MailActionDecode Addline CStr(Mail1.Buffer) Else For I = 0 To Mail1.BodyCount - 1 Addline CStr(Mail1.Body(I)) Next End If End Sub Private Sub DisplayMessage() Dim dwrtn As Long ' ' Empty text box, suspend redraws, load message into textbox ' textBody.Text = "" dwrtn = SendMessage(textBody.hWnd, WM_SETREDRAW, 0, 0&) DisplayMessageText textBody.SelLength = 0 dwrtn = SendMessage(textBody.hWnd, WM_SETREDRAW, -1, 0&) End Sub Private Sub DisplayMessageText() Dim Part As Integer Dim ctype As String Dim csubtype As String ctype = LCase$(Mail1.ContentType) csubtype = LCase$(Mail1.ContentSubtype) ' ' Display header if required ' If (ShowHeaders.Checked) Then Addline CStr(Mail1.HeaderText) End If ' ' If there's only one part then just display it ' If (Mail1.Parts = 0) Then If ((ctype = "text" And csubtype = "plain")) Then ' Or (ctype = "message" And csubtype = "rfc822")) Then DisplayBody Else DisplayAttachmentMarker (Part) End If Else ' ' Multiple parts, first part is displayed if it can ' be otherwise it's displayed as an attachment. ' All other parts are displayed as attachments. ' For Part = 0 To Mail1.Parts - 1 Mail1.Part = Part Mail1.Action = MailActionDescend ctype = LCase$(Mail1.ContentType) csubtype = LCase$(Mail1.ContentSubtype) If ((ctype = "text" And csubtype = "plain")) Then ' Or (ctype = "message" And csubtype = "rfc822")) Then DisplayBody Else DisplayAttachmentMarker (Part) End If Mail1.Action = MailActionAscend Next End If End Sub Private Sub FileExit_Click() End End Sub Private Sub Form_Load() Dim DirName As String Dim dwrtn As Long Static stops(3) As Long ' ' Before you can use this program you must modify the ' following two lines of code so that they point to ' some existing valid directories on your system ' ' You must also change the values below (for the ' user name, hosts, etc.). ' ' Be sure to comment out the message box when ' you are done making the modifications. ' ' MailDir = "c:\Email\" ' InboxDir = "c:\Email\InBox\" ' If (MailDir = "" Or InboxDir = "") Then MsgBox "You must make modifications to the source code prior to running this sample. Break into the debugger now and read the comments before and after this message box." End If If Right(MailDir, 1) <> "\" Then MailDir = MailDir & "\" End If If Right(InboxDir, 1) <> "\" Then InboxDir = InboxDir & "\" End If ' ' your user-friendly name goes here ' g_username = "Your Name" ' ' your smtp host's name or ip address ' g_SmtpHost = "mailhost.yourhost.com" ' ' your pop3 host's name or ip address ' g_PopHost = "pophost.yourhost.com" ' ' your e-mail address ' g_emailaddr = "you@yourhost.com" ' ' your pop3 login name and password ' g_PopUserName = "you" g_PopPassword = "yourpassword" If (Mail1.Blocking = True) Then chkBlocking.Value = 1 Else chkBlocking.Value = 0 End If Me.Show ' ' Set listbox tabs ' stops(0) = 125 stops(1) = 275 stops(2) = 500 dwrtn = SendMessage(listMessages.hWnd, LB_SETTABSTOPS, 3, stops(0)) vbCrLf = Chr$(13) & Chr$(10) dwrtn = SendMessage(textBody.hWnd, EM_SETREADONLY, True, 0) ' ' Display user and connection info ' SetPopupPos UserInfo UserInfo.Show 1 SetPopupPos ConnectionOptionsForm ConnectionOptionsForm.Show 1 ' ' Load list of folders, subdirs of Const MailDir ' DirName = Dir(MailDir, 16) Do While (DirName <> "") If (Left(DirName, 1) <> ".") Then DirName = UCase$(Left(DirName, 1)) & LCase$(Right(DirName, Len(DirName) - 1)) listFolders.AddItem DirName End If DirName = Dir Loop listFolders.ListIndex = 0 End Sub Private Sub Form_Resize() If Me.WindowState = 1 Then Exit Sub End If Line1.X1 = 0 Line2.X1 = 0 Line1.X2 = Me.ScaleWidth Line2.X2 = Me.ScaleWidth cmdVSplit.Height = cmdHSplit.Top - Line2.Y2 - 1 cmdHSplit.Left = 0 cmdHSplit.Width = Me.ScaleWidth listFolders.Top = Line2.Y1 + Margin listFolders.Height = cmdHSplit.Top - Line2.Y1 - Margin * 2 listFolders.Left = Margin listFolders.Width = cmdVSplit.Left - Margin * 2 listMessages.Top = Line2.Y1 + Margin listMessages.Height = cmdHSplit.Top - Line2.Y1 - Margin * 2 listMessages.Left = cmdVSplit.Left + cmdVSplit.Width + Margin listMessages.Width = Me.ScaleWidth - listMessages.Left - Margin textBody.Top = cmdHSplit.Top + cmdHSplit.Height + Margin textBody.Height = Me.ScaleHeight - (cmdHSplit.Top + cmdHSplit.Height) - Margin * 2 textBody.Left = Margin textBody.Width = Me.ScaleWidth - Margin * 2 End Sub Private Function GetEditControlLine(hWnd As Long, lineno As Integer) As String Dim dwrtn As Long Dim linelen As Long Dim S As String Dim charno As Long ' Get first char on line charno = SendMessage(hWnd, EM_LINEINDEX, lineno, 0&) ' So we can get the length linelen = SendMessage(hWnd, EM_LINELENGTH, charno, 0&) ' Allocate buffer and initialize. Length of buffer is ' stored in first two bytes. S = String$(linelen + 1, 0) S = Chr((CInt(linelen) And &HFF00) \ 255) & S S = Chr((CInt(linelen) And &HFF)) & S ' Read line from textbox dwrtn = SendMessage(hWnd, EM_GETLINE, lineno, ByVal S) GetEditControlLine = S End Function Private Function GetNewFilename(DirName As String) As String Dim I As Integer For I = 0 To UBound(DirInfo) If (UCase(DirInfo(I).DirName) = UCase(DirName)) Then DirInfo(I).HighestMsg = DirInfo(I).HighestMsg + 1 GetNewFilename = Format(DirInfo(I).HighestMsg, "00000000.msg") Exit Function End If Next I MsgBox "Ouch! Couldn't make new file in " & DirName End End Function Private Sub Label1_Click() End Sub Private Sub listFolders_Click() Dim filename As String Dim filenames() As String Dim stab As String Dim curnum As Long Dim highnum As Long Dim I As Integer ReDim Preserve filenames(0) As String highnum = -1 ' ' Folder chosen, list messages. ' stab = Chr$(9) listMessages.Clear CurrentFolder = listFolders.List(listFolders.ListIndex) 'NOTE-If you get an error on the below line, you need to create 'a valid inbox as described in the Form_Load procedure. filename = Dir(MailDir & CurrentFolder & "\" & "*.msg", 0) Do While (filename <> "") filenames(UBound(filenames)) = filename ReDim Preserve filenames(UBound(filenames) + 1) As String filename = Dir Loop If UBound(filenames) <= 0 Then UpdateCounter CurrentFolder, 0 Else ReDim Preserve filenames(UBound(filenames) - 1) As String SortStringArray filenames() For I = 0 To UBound(filenames) filename = filenames(I) ' ' Read message ' Mail1.SrcFilename = MailDir & CurrentFolder & "\" & listMessages.List(listMessages.ListIndex) & filename Mail1.Flags = MailSrcIsFile Mail1.Action = MailActionReadMessage ' ' Display subject, from, data ' listMessages.AddItem Mail1.Subject & stab & Mail1.From & stab & Mail1.Date ' ' Filename is dddddddd.msg, stash dddddddd part in ItemData ' curnum = Val(filename) listMessages.ItemData(listMessages.NewIndex) = Val(filename) If (highnum < curnum) Then highnum = curnum End If Next UpdateCounter CurrentFolder, highnum End If End Sub Private Sub listMessages_Click() Dim dwrtn As Long ' Chose a message, make name from ItemData Mail1.SrcFilename = MailDir & CurrentFolder & "\" & Format(listMessages.ItemData(listMessages.ListIndex), "00000000.msg") ' Read and display Mail1.Flags = MailSrcIsFile Mail1.Action = MailActionReadMessage DisplayMessage End Sub Private Sub Mail1_AsyncError(ByVal ErrorCode As Integer, ByVal ErrorMsg As String) MsgBox "AsyncError: " & ErrorMsg & "(" & Str(ErrorCode) & ")" End Sub Private Sub MAIL1_Debug(ByVal message As String) If (chkTrace.Value <> 0) Then Debug.Print message End If End Sub Private Sub Mail1_Done() Select Case State Case StateConnecting State = StateGettingEMail If (Mail1.PopMessageCount <> 0) Then cmdGetMail.Enabled = False GettingMessage = 0 NextCommand = MailActionReadMessage Timer1.Enabled = True Else MsgBox "No mail waiting" State = StateDisconnecting Mail1.Action = MailActionDisconnect End If Case StateGettingEMail ' ' Write received message to disk ' Mail1.Flags = MailDstIsFile Mail1.DstFilename = MailDir & CurrentFolder & "\" & GetNewFilename(CurrentFolder) Mail1.Action = MailActionWriteMessage ' ' Figure out what to do next ' If (chkHostDelete.Value = 1) Then NextCommand = MailActionHostDelete ElseIf (GettingMessage < Mail1.PopMessageCount) Then NextCommand = MailActionReadMessage Else NextCommand = MailActionDisconnect End If Timer1.Enabled = True Case StateDeleting If (GettingMessage < Mail1.PopMessageCount) Then NextCommand = MailActionReadMessage Else NextCommand = MailActionDisconnect End If Timer1.Enabled = True Case StateDisconnecting cmdGetMail.Enabled = True State = StateDisconnected listFolders_Click End Select End Sub Private Sub SetPopupPos(foo As Form) foo.Top = Me.Top + Me.Height / 5 foo.Left = Me.Left + (Me.Width - foo.Width) / 2 End Sub Private Sub Mail1_Progress(ByVal Numerator As Long, ByVal Denominator As Long) If (Denominator <> 0) Then lblPercentage.Caption = Format(Fix(Numerator / Denominator * 100)) & "%" Else lblPercentage.Caption = 0 End If End Sub Private Sub SettingsConnection_Click() SetPopupPos ConnectionOptionsForm ConnectionOptionsForm.Show 1 End Sub Private Sub SettingsUser_Click() SetPopupPos UserInfo UserInfo.Show 1 End Sub Private Sub ShowHeaders_Click() ShowHeaders.Checked = Not ShowHeaders.Checked ' Skip errors here if Click when there is no ' selected message On Error Resume Next DisplayMessage If (Err <> 0 And Err <> 380) Then MsgBox Error End If On Error GoTo 0 End Sub Private Sub ShowSourceMenu_Click() Mail1.Flags = MailDstIsBuffer Mail1.Action = MailActionWriteMessage SourceDisplay.text1.Text = Mail1.Buffer SourceDisplay.Show End Sub Private Sub SortStringArray(aFiles() As String) Dim Distance As Integer Dim Size As Integer Dim index As Integer Dim NextElement As Integer Dim Temp As String Size = UBound(aFiles) - LBound(aFiles) + 1 Distance = 1 While (Distance <= Size) Distance = 2 * Distance Wend Distance = (Distance / 2) - 1 While (Distance > 0) NextElement = LBound(aFiles) + Distance While (NextElement <= UBound(aFiles)) index = NextElement Do If index >= (LBound(aFiles) + Distance) Then If aFiles(index) < aFiles(index - Distance) Then Temp = aFiles(index) aFiles(index) = aFiles(index - Distance) aFiles(index - Distance) = Temp Else Exit Do End If Else Exit Do End If Loop NextElement = NextElement + 1 Wend Distance = (Distance - 1) / 2 Wend End Sub Private Sub textBody_Click() ' textBody.SelLength = 0 End Sub Private Sub textBody_DblClick() Dim dwrtn As Long Dim lineno As Long Dim linelen As Long Dim S As String Dim I As Integer textBody.SelLength = 0 lineno = SendMessage(textBody.hWnd, EM_LINEFROMCHAR, -1, 0&) If (lineno = 0) Then ' can't possibly be of interest Exit Sub End If S = GetEditControlLine(CLng(textBody.hWnd), CInt(lineno)) ' ' shortcut out if not possibly significant ' If (Len(S) < 20) Then Exit Sub End If ' ' Ok, see if this is an attachment line ' If (Left(S, 9) = "Content: " And InStr(S, "Double-click this line to display") <> 0) Then ' ' Got an attachment, just put up message if can't be displayed ' If (InStr(S, "text\plain") = 0 And InStr(S, "message") = 0 And InStr(S, "multipart") = 0) Then MsgBox "This part requires special handling. Might be a zip file, for instance." Else ' ' Get previous line, has ----- Attachment {n}n ----- ' S = GetEditControlLine(CLng(textBody.hWnd), CInt(lineno - 1)) ' ' sleazy trick, works for upto 99 attachments ' Mail1.Part = Val(Right(S, 11)) Mail1.Action = MailActionDescend textBody.Text = "" DisplayMessage End If End If End Sub Private Sub textBody_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' textBody.SelLength = 0 End Sub Private Sub Timer1_Timer() Static inhere As Integer If (inhere <> 0) Then Exit Sub End If inhere = 1 Timer1.Enabled = False Select Case NextCommand Case MailActionReadMessage State = StateGettingEMail GettingMessage = GettingMessage + 1 Mail1.MessageID = Format(GettingMessage) Mail1.Flags = MailSrcIsHost Mail1.Action = MailActionReadMessage Case MailActionHostDelete State = StateDeleting Mail1.Action = MailActionHostDelete Case MailActionDisconnect State = StateDisconnecting Mail1.Action = MailActionDisconnect Case MailActionAbort State = StateAborting Mail1.Action = MailActionAbort End Select If (Mail1.Blocking = True) Then Mail1_Done End If inhere = 0 End Sub Private Sub UpdateCounter(DirName As String, Value As Long) Dim I As Integer For I = 0 To UBound(DirInfo) If (DirInfo(I).DirName = "") Then Exit For End If Next I If ((I = UBound(DirInfo)) And (DirInfo(I).DirName <> "")) Then Exit Sub End If DirInfo(I).DirName = DirName DirInfo(I).HighestMsg = Value End Sub 
(.txt)